(DECLARE (SETSYNTAX 35 2 35))


(DECLARE (SPECIAL %/#CONTINUE %/#CONTINUE-STACK %/#RETAIN %/#CE
		  %/#ALIST COMPILE-MACROS UMATCH-ALIST))


(DECLARE (SPECIAL %/#FULL-PREDICATE %/#OCCURS))


(SETQ %/#FULL-PREDICATE NIL)


(DECLARE (FASLOAD STRUCT FAS DSK (MAC LSP)))


(SETQ %/#CONTINUE NIL 
      %/#CONTINUE-STACK NIL 
      %/#RETAIN NIL 
      COMPILE-MACROS NIL 
      %/#OCCURS NIL 
      UMATCH-ALIST NIL)


(DEFUN %%OCCURS (X L) 
  (COND ((MEMQ L (CDR (ASSQ X %/#OCCURS))) T)
	((EQ X L) NIL)
	(T (%%OCCURS1 X L L))))


(DEFUN %%OCCURS1 (X L TOP) 
  (COND ((NULL L) NIL)
	((EQ X L)
	 ((LAMBDA (ENTRY) 
	    (COND (ENTRY (NCONC ENTRY (LIST TOP)))
		  (T (SETQ %/#OCCURS (CONS (LIST X TOP) %/#OCCURS)))))
	  (ASSQ X %/#OCCURS))
	 T)
	((ATOM L) NIL)
	(T (OR (%%OCCURS1 X (CAR L) TOP) (%%OCCURS1 X (CDR L) TOP)))))


(DECLARE (SPECIAL -SEEN-))


(DEFUN %%CHECK (L) ((LAMBDA (-SEEN-) (%%CHECK1 L)) NIL))


(DEFUN %%CHECK1 (L) 
  (COND ((MEMQ L -SEEN-) L)
	((ATOM L) L)
	((HUNKP L) (SETQ -SEEN- (CONS L -SEEN-)) L)
	((EQ (CAR L) '-SPECIAL-FORM-) (CDR L))
	((MEMQ (CAR L)
	       '($R RESTRICT ⊗R $IR IRESTRICT ⊗IR $CH $CHOOSE))
	 (CADR L))
	(T (SETQ -SEEN- (CONS L -SEEN-))
	   (CONS (%%CHECK1 (CAR L)) (%%CHECK1 (CDR L))))))


(DEFUN %%SPECIAL-FORMP (X) 
  (COND (%/#FULL-PREDICATE NIL)
	((ATOM X)
	 (OR (EQ X '-SPECIAL-FORM-)
	     (AND (NOT (EQ X '=))
		  (MEMQ (COND ((EQ (TYPEP X) 'SYMBOL)
			       (GETCHAR X 1)))
			'(? * =)))))
	(T (OR (EQ (CAR X) '-SPECIAL-FORM-)
	       (AND (NOT (ATOM X))
		    (MEMQ (CAR X)
			  '($R RESTRICT ⊗R $IR IRESTRICT ⊗IR)))))))


(COMMENT CATCH-MATCH)


(DECLARE (SETQ DEFMACRO-FOR-COMPILING NIL) (MAPEX T))